home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / access / TKNLB2.POL.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  31.4 KB  |  857 lines
  1. C
  2. C  Revised Token stream access functions - version 2.
  3. C
  4. C  GENERAL
  5. C  ------
  6. C
  7. C  ZTOKTX  Return the expanded text of a token, i.e. the string
  8. C          that it actually represents
  9. C  ZTOKNM  Return a string containing the name of a token.
  10. C
  11. C
  12. C  INPUT
  13. C  -----
  14. C
  15. C  ZTKGTI  Initialise input from a given source.
  16. C  ZTKGTQ  Terminate input from a given source.
  17. C  ZSCAN   Dummy routine.
  18. C  ZGETTK  Get the next token from the specified file.
  19. C
  20. C
  21. C  OUTPUT
  22. C  ------
  23. C
  24. C  ZTKPTI  Initialise output to a given source.
  25. C  ZTKPTQ  Terminate output to a given source.
  26. C  ZUSCAN  Dummy routine.
  27. C  ZPUTTK  Put the next token to the specified files.
  28. C  PLOPTF  Dummy routine.
  29. C  POLOPT  Dummy routine.
  30. C
  31. C  LOW LEVEL ROUTINES
  32. C  ------------------
  33. C
  34. C  XTKADD  Add a character to an internal buffer, flush to
  35. C          a file if full.
  36. C  XTKSUB  Get a character from an internal buffer, refill
  37. C          from a file if empty.
  38. C
  39. C----------------------------------------------------------
  40. C
  41. C       Z T O K T X  -  Convert token from stream into text
  42. C
  43. C       STATUS : INTEGER (result) -- err/ok
  44. C       TYPE   : INTEGER    Type of token from ZTREAD/ZTOKRD
  45. C       LENGTH : INTEGER    Length of associated text string
  46. C       STRING : INTEGER(*) Associated text string
  47. C       TEXT   : INTEGER(*) Resultant text
  48. C
  49.         INTEGER FUNCTION ZTOKTX(TYPE,LENGTH,STRING,TEXT)
  50.  
  51. C---------------------------------------------------------
  52. C    TOOLPACK/1    Release: 2.1
  53. C---------------------------------------------------------
  54. C
  55. C  TKLAST = LAST TOKEN NUMBER
  56. C
  57.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  58.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  59.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  60.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  61.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  62.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  63.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  64.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  65.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  66.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  67.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  68.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  69.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  70.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  71.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  72.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  73.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  74.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  75.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  76.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  77.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  78.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  79.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  80.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  81.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  82.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  83.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  84.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  85.  
  86.         INTEGER TYPE,LENGTH,STRING(*),TEXT(*)
  87.         INTEGER TOKTXT(488),INDEX(TKLAST),I,J
  88.         SAVE
  89.  
  90.         INTEGER ITOC
  91.         EXTERNAL ITOC
  92.  
  93.         DATA (TOKTXT(I),I=1,74)/60,101,111,102,62,129,
  94.      +      65,83,83,73,71,78,32,129,
  95.      +      66,65,67,75,83,80,65,67,69,32,129,
  96.      +      66,76,79,67,75,32,68,65,84,65,32,129,
  97.      +      67,65,76,76,32,129,
  98.      +      67,76,79,83,69,32,129,
  99.      +      67,79,77,77,79,78,32,129,
  100.      +      67,79,78,84,73,78,85,69,32,129,
  101.      +      68,65,84,65,32,129/
  102.         DATA(TOKTXT(I),I=75,152)/68,79,32,129,
  103.      +      68,73,77,69,78,83,73,79,78,32,129,
  104.      +      69,76,83,69,129,
  105.      +      69,76,83,69,32,73,70,129,
  106.      +      69,78,68,129,
  107.      +      69,78,68,70,73,76,69,32,129,
  108.      +      69,78,68,32,73,70,129,
  109.      +      69,78,84,82,89,32,129,
  110.      +      69,81,85,73,86,65,76,69,78,67,69,
  111.      +32,129,
  112.      +      69,88,84,69,82,78,65,76,32,129/
  113.         DATA(TOKTXT(I),I=153,217)/
  114.      +      70,85,78,67,84,73,79,78,32,129,
  115.      +      70,79,82,77,65,84,32,129,
  116.      +      71,79,32,84,79,32,129,
  117.      +      73,70,32,129,
  118.      +      73,77,80,76,73,67,73,84,32,129,
  119.      +      73,78,81,85,73,82,69,32,129,
  120.      +      73,78,84,82,73,78,83,73,67,32,129,
  121.      +      79,80,69,78,32,129/
  122.         DATA(TOKTXT(I),I=218,279)/
  123.      +      80,65,82,65,77,69,84,69,82,32,129,
  124.      +      80,65,85,83,69,32,129,
  125.      +      80,82,73,78,84,32,129,
  126.      +      80,82,79,71,82,65,77,32,129,
  127.      +      82,69,65,68,32,129,
  128.      +      82,69,84,85,82,78,32,129,
  129.      +      82,69,87,73,78,68,32,129,
  130.      +      83,65,86,69,32,129/
  131.         DATA(TOKTXT(I),I=280,347)/83,84,79,80,32,129,
  132.      +      83,85,66,82,79,85,84,73,78,69,32,129,
  133.      +      84,72,69,78,32,129,
  134.      +      84,79,32,129,
  135.      +      87,82,73,84,69,32,129,
  136.      +      73,78,84,69,71,69,82,32,129,
  137.      +      82,69,65,76,32,129,
  138.      +      68,79,85,66,76,69,32,80,82,69,67,
  139.      +73,83,73,79,78,32,129/
  140.         DATA(TOKTXT(I),I=348,406)/
  141.      +      67,79,77,80,76,69,88,32,129,
  142.      +      76,79,71,73,67,65,76,32,129,
  143.      +      67,72,65,82,65,67,84,69,82,32,129,
  144.      +      44,129,61,129,58,129,40,129,41,129,
  145.      +      46,76,69,46,129,
  146.      +      46,76,84,46,129,
  147.      +      46,69,81,46,129,
  148.      +      46,78,69,46,129/
  149.         DATA(TOKTXT(I),I=407,460)/46,71,69,46,129,
  150.      +      46,71,84,46,129,
  151.      +      46,65,78,68,46,129,
  152.      +      46,79,82,46,129,
  153.      +      46,69,81,86,46,129,
  154.      +      46,78,69,81,86,46,129,
  155.      +      46,78,79,84,46,129,
  156.      +      42,129,42,42,129,43,129,45,129,
  157.      +      47,129,47,47,129/
  158.         DATA(TOKTXT(I),I=461,473)/129,
  159.      +      70,77,84,129,
  160.      +      69,78,68,129,
  161.      +      69,82,82,129/
  162.         DATA(TOKTXT(I),I=474,488)/68,79,85,66,76,69,32,
  163.      +      67,79,77,80,76,69,88,129/
  164.  
  165.         DATA INDEX/1,7,15,26,38,44,51,59,69,75,79,90,95,103,107,116,123,
  166.      +130,143,153,163,171,178,182,192,201,212,218,229,236,243,252,258,
  167.      +266,274,280,286,298,304,308,315,324,330,348,357,366,474,377,379,
  168.      +381,383,385,387,392,397,402,407,412,417,423,428,434,441,447,449,
  169.      +452,454,456,458,461,461,461,461,461,461,461,461,461,461,461,462,
  170.      +466,470/
  171.  
  172.         IF (TYPE.EQ.TCCNST) THEN
  173.             J=2
  174.             TEXT(1)=39
  175.             DO 200 I=1,LENGTH
  176.                 TEXT(J)=STRING(I)
  177.                 J=J+1
  178.                 IF (STRING(I).EQ.39) THEN
  179.                     TEXT(J)=39
  180.                     J=J+1
  181.                 END IF
  182.  200        CONTINUE
  183.             TEXT(J)=39
  184.             TEXT(J+1)=129
  185.         ELSE IF (TYPE.EQ.THCNST) THEN
  186.             I=ITOC(LENGTH,TEXT,12)+1
  187.             TEXT(I)=72
  188.             DO 400 J=1,LENGTH
  189.  400            TEXT(J+I)=STRING(J)
  190.             TEXT(I+LENGTH+1)=129
  191.         ELSE IF (LENGTH.GT.0) THEN
  192.             DO 100 I=1,LENGTH
  193.  100            TEXT(I)=STRING(I)
  194.             TEXT(LENGTH+1)=129
  195.         ELSE
  196.             I=1
  197.  300        TEXT(I)=TOKTXT(I+INDEX(TYPE)-1)
  198.             I=I+1
  199.             IF (TEXT(I-1).NE.129) GOTO 300
  200.         END IF
  201.         ZTOKTX=-2
  202.  
  203.         END
  204. C-------------------------------------------------
  205. C
  206. C       Z T O K N M  -  Return the name of a token
  207. C
  208. C       STATUS : INTEGER (result) -- err/ok
  209. C       TYPE   : INTEGER    Type of token (numeric value)
  210. C       TEXT   : INTEGER(*) Resultant text
  211. C
  212.         INTEGER FUNCTION ZTOKNM(TYPE, TEXT)
  213.  
  214. C---------------------------------------------------------
  215. C    TOOLPACK/1    Release: 2.1
  216. C---------------------------------------------------------
  217. C
  218. C  TKLAST = LAST TOKEN NUMBER
  219. C
  220.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  221.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  222.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  223.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  224.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  225.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  226.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  227.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  228.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  229.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  230.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  231.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  232.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  233.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  234.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  235.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  236.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  237.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  238.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  239.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  240.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  241.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  242.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  243.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  244.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  245.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  246.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  247.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  248.  
  249.         INTEGER TYPE
  250.         INTEGER TEXT(*), TXT(7, TKLAST)
  251.         SAVE
  252.  
  253.         DATA (TXT(I,TZEOF),I=1,7)/84,90,69,79,70,32,129/
  254.         DATA (TXT(I,TASSIG),I=1,7)/84,65,83,83,73,71,129/
  255.         DATA (TXT(I,TBACKS),I=1,7)/84,66,65,67,75,83,129/
  256.         DATA (TXT(I,TBLOCK),I=1,7)/84,66,76,79,67,75,129/
  257.         DATA (TXT(I,TCALL),I=1,7)/84,67,65,76,76,32,129/
  258.         DATA (TXT(I,TCLOSE),I=1,7)/84,67,76,79,83,69,129/
  259.         DATA (TXT(I,TCOMMO),I=1,7)/84,67,79,77,77,79,129/
  260.         DATA (TXT(I,TCONTI),I=1,7)/84,67,79,78,84,73,129/
  261.         DATA (TXT(I,TDATA),I=1,7)/84,68,65,84,65,32,129/
  262.         DATA (TXT(I,TDO),I=1,7)/84,68,79,32,32,32,129/
  263.         DATA (TXT(I,TDIMEN),I=1,7)/84,68,73,77,69,78,129/
  264.         DATA (TXT(I,TELSE),I=1,7)/84,69,76,83,69,32,129/
  265.         DATA (TXT(I,TELSIF),I=1,7)/84,69,76,83,73,70,129/
  266.         DATA (TXT(I,TEND),I=1,7)/84,69,78,68,32,32,129/
  267.         DATA (TXT(I,TENDFI),I=1,7)/84,69,78,68,70,73,129/
  268.         DATA (TXT(I,TENDIF),I=1,7)/84,69,78,68,73,70,129/
  269.         DATA (TXT(I,TENTRY),I=1,7)/84,69,78,84,82,89,129/
  270.         DATA (TXT(I,TEQUIV),I=1,7)/84,69,81,85,73,86,129/
  271.         DATA (TXT(I,TEXTER),I=1,7)/84,69,88,84,69,82,129/
  272.         DATA (TXT(I,TFUNCT),I=1,7)/84,70,85,78,67,84,129/
  273.         DATA (TXT(I,TFORMA),I=1,7)/84,70,79,82,77,65,129/
  274.         DATA (TXT(I,TGOTO),I=1,7)/84,71,79,84,79,32,129/
  275.         DATA (TXT(I,TIF),I=1,7)/84,73,70,32,32,32,129/
  276.         DATA (TXT(I,TIMPLI),I=1,7)/84,73,77,80,76,73,129/
  277.         DATA (TXT(I,TINQUI),I=1,7)/84,73,78,81,85,73,129/
  278.         DATA (TXT(I,TINTRI),I=1,7)/84,73,78,84,82,73,129/
  279.         DATA (TXT(I,TOPEN),I=1,7)/84,79,80,69,78,32,129/
  280.         DATA (TXT(I,TPARAM),I=1,7)/84,80,65,82,65,77,129/
  281.         DATA (TXT(I,TPAUSE),I=1,7)/84,80,65,85,83,69,129/
  282.         DATA (TXT(I,TPRINT),I=1,7)/84,80,82,73,78,84,129/
  283.         DATA (TXT(I,TPROGR),I=1,7)/84,80,82,79,71,82,129/
  284.         DATA (TXT(I,TREAD),I=1,7)/84,82,69,65,68,32,129/
  285.         DATA (TXT(I,TRETUR),I=1,7)/84,82,69,84,85,82,129/
  286.         DATA (TXT(I,TREWIN),I=1,7)/84,82,69,87,73,78,129/
  287.         DATA (TXT(I,TSAVE),I=1,7)/84,83,65,86,69,32,129/
  288.         DATA (TXT(I,TSTOP),I=1,7)/84,83,84,79,80,32,129/
  289.         DATA (TXT(I,TSUBRO),I=1,7)/84,83,85,66,82,79,129/
  290.         DATA (TXT(I,TTHEN),I=1,7)/84,84,72,69,78,32,129/
  291.         DATA (TXT(I,TTO),I=1,7)/84,84,79,32,32,32,129/
  292.         DATA (TXT(I,TWRITE),I=1,7)/84,87,82,73,84,69,129/
  293.         DATA (TXT(I,TINTEG),I=1,7)/84,73,78,84,69,71,129/
  294.         DATA (TXT(I,TREAL),I=1,7)/84,82,69,65,76,32,129/
  295.         DATA (TXT(I,TDOUBL),I=1,7)/84,68,79,85,66,76,129/
  296.         DATA (TXT(I,TCOMPL),I=1,7)/84,67,79,77,80,76,129/
  297.         DATA (TXT(I,TLOGIC),I=1,7)/84,76,79,71,73,67,129/
  298.         DATA (TXT(I,TCHARA),I=1,7)/84,67,72,65,82,65,129/
  299.         DATA (TXT(I,TDCMPL),I=1,7)/84,68,67,77,80,76,129/
  300.         DATA (TXT(I,TCOMMA),I=1,7)/84,67,79,77,77,65,129/
  301.         DATA (TXT(I,TEQUAL),I=1,7)/84,69,81,85,65,76,129/
  302.         DATA (TXT(I,TCOLON),I=1,7)/84,67,79,76,79,78,129/
  303.         DATA (TXT(I,TLPARN),I=1,7)/84,76,80,65,82,78,129/
  304.         DATA (TXT(I,TRPARN),I=1,7)/84,82,80,65,82,78,129/
  305.         DATA (TXT(I,TLE),I=1,7)/84,76,69,32,32,32,129/
  306.         DATA (TXT(I,TLT),I=1,7)/84,76,84,32,32,32,129/
  307.         DATA (TXT(I,TEQ),I=1,7)/84,69,81,32,32,32,129/
  308.         DATA (TXT(I,TNE),I=1,7)/84,78,69,32,32,32,129/
  309.         DATA (TXT(I,TGE),I=1,7)/84,71,69,32,32,32,129/
  310.         DATA (TXT(I,TGT),I=1,7)/84,71,84,32,32,32,129/
  311.         DATA (TXT(I,TAND),I=1,7)/84,65,78,68,32,32,129/
  312.         DATA (TXT(I,TOR),I=1,7)/84,79,82,32,32,32,129/
  313.         DATA (TXT(I,TEQV),I=1,7)/84,69,81,86,32,32,129/
  314.         DATA (TXT(I,TNEQV),I=1,7)/84,78,69,81,86,32,129/
  315.         DATA (TXT(I,TNOT),I=1,7)/84,78,79,84,32,32,129/
  316.         DATA (TXT(I,TSTAR),I=1,7)/84,83,84,65,82,32,129/
  317.         DATA (TXT(I,TDSTAR),I=1,7)/84,68,83,84,65,82,129/
  318.         DATA (TXT(I,TPLUS),I=1,7)/84,80,76,85,83,32,129/
  319.         DATA (TXT(I,TMINUS),I=1,7)/84,77,73,78,85,83,129/
  320.         DATA (TXT(I,TSLASH),I=1,7)/84,83,76,65,83,72,129/
  321.         DATA (TXT(I,TCNCAT),I=1,7)/84,67,78,67,65,84,129/
  322.         DATA (TXT(I,TDCNST),I=1,7)/84,68,67,78,83,84,129/
  323.         DATA (TXT(I,TLCNST),I=1,7)/84,76,67,78,83,84,129/
  324.         DATA (TXT(I,TRCNST),I=1,7)/84,82,67,78,83,84,129/
  325.         DATA (TXT(I,TPCNST),I=1,7)/84,80,67,78,83,84,129/
  326.         DATA (TXT(I,TCCNST),I=1,7)/84,67,67,78,83,84,129/
  327.         DATA (TXT(I,THCNST),I=1,7)/84,72,67,78,83,84,129/
  328.         DATA (TXT(I,TNAME),I=1,7)/84,78,65,77,69,32,129/
  329.         DATA (TXT(I,TFIELD),I=1,7)/84,70,73,69,76,68,129/
  330.         DATA (TXT(I,TSCALE),I=1,7)/84,83,67,65,76,69,129/
  331.         DATA (TXT(I,TZEOS),I=1,7)/84,90,69,79,83,32,129/
  332.         DATA (TXT(I,TCMMNT),I=1,7)/84,67,77,77,78,84,129/
  333.         DATA (TXT(I,TFMTKD),I=1,7)/84,70,77,84,75,68,129/
  334.         DATA (TXT(I,TENDKD),I=1,7)/84,69,78,68,75,68,129/
  335.         DATA (TXT(I,TERRKD),I=1,7)/84,69,82,82,75,68,129/
  336.  
  337.         IF((TYPE .LE. 0) .OR. (TYPE .GT. TKLAST)) THEN
  338.           CALL REMARK('ZTOKNM: TYPE ARGUMENT OUT OF RANGE')
  339.           TEXT(1) = 129
  340.           ZTOKNM = -1
  341.           RETURN
  342.  
  343.         ELSE
  344.           CALL SCOPY(TXT(1, TYPE), 1, TEXT, 1)
  345.           ZTOKNM = -2
  346.  
  347.         ENDIF
  348.  
  349.         END
  350. C----------------------------------------------------
  351. C
  352. C  INITIALISE TOKEN INPUT.
  353. C
  354. C  TYPE = 0   ERROR, THIS VERSION DOES NOT HAVE A SCANNER.
  355. C  TYPE > 0   INPUT USING TOKEN READ FROM A FILE.
  356. C  TYPE < 0   ERROR.
  357. C
  358.       INTEGER FUNCTION ZTKGTI(TYPE, FD1, FD2)
  359.  
  360.       INTEGER  FD1, FD2, TYPE, I
  361.       LOGICAL  FIRST
  362.  
  363.       INTEGER LIMIT, MAXSET, SIZE, LENT
  364.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  365.  
  366.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  367.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  368.      +        LSTTKN(LIMIT), INTYP(LIMIT)
  369.       COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  370.      +        LSTTKN, INTYP, MAXSET
  371.       SAVE
  372.  
  373.       DATA FIRST/.TRUE./
  374.  
  375.       ZTKGTI = -1
  376.       IF(FIRST) THEN
  377.         MAXSET = 0
  378.         FIRST = .FALSE.
  379.         DO 10 I = 1, LIMIT
  380.           INTYP(I) = -100
  381.    10   CONTINUE
  382.       ENDIF
  383.       IF(MAXSET .EQ. LIMIT) RETURN
  384.       IF(TYPE .LE. 0) RETURN
  385.  
  386.       IF(FD1 .GT. 0) CALL SEEK(0, FD1)
  387.       IF(FD2 .GT. 0) CALL SEEK(0, FD2)
  388.  
  389.       MAXSET = MAXSET + 1
  390.       DO 20 I = 1, LIMIT
  391.         IF(INTYP(I) .EQ. -100) THEN
  392.           INTYP(I)  = TYPE
  393.           FDTOKS(I) = FD1
  394.           FDCMTS(I) = FD2
  395.           TPOINT(I) = SIZE + 1
  396.           CPOINT(I) = SIZE + 1
  397.           LSTTKN(I) = 0
  398.  
  399.           ZTKGTI = I
  400.           RETURN
  401.         ENDIF
  402.    20 CONTINUE
  403.  
  404.       END
  405. C----------------------------------------------------
  406. C
  407. C  TERMINATE TOKEN INPUT.
  408. C
  409.       SUBROUTINE ZTKGTQ(CHAN)
  410.  
  411.       INTEGER  CHAN
  412.  
  413.       INTEGER LIMIT, MAXSET, LENT, SIZE
  414.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  415.  
  416.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  417.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  418.      +        LSTTKN(LIMIT), INTYP(LIMIT)
  419.       COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  420.      +        LSTTKN, INTYP, MAXSET
  421.  
  422.       SAVE
  423.  
  424.       INTYP(CHAN) = -100
  425.       MAXSET = MAX(MAXSET-1, 0)
  426.  
  427.       END
  428. C----------------------------------------------------
  429. C
  430. C  INITIALISE TOKEN OUTPUT.
  431. C
  432. C  TYPE = 0   ERROR, NO POLISH ATTACHED.
  433. C  TYPE > 0   OUTPUT TO A TOKEN STREAM AND COMMENT FILE PAIR.
  434. C  TYPE < 0   ERROR.
  435. C
  436.       INTEGER FUNCTION ZTKPTI(TYPE, FD1, FD2)
  437.  
  438.       INTEGER  FD1, FD2, TYPE
  439.       LOGICAL  FIRST
  440.  
  441.       INTEGER LIMIT, MAXSET, SIZE, LENT
  442.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  443.  
  444.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  445.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  446.      +        LSTTKN(LIMIT), OUTTYP(LIMIT)
  447.       COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  448.      +        LSTTKN, OUTTYP, MAXSET
  449.       SAVE
  450.       INTEGER I
  451.  
  452.       DATA FIRST/.TRUE./
  453.  
  454.       ZTKPTI = -1
  455.       IF(FIRST) THEN
  456.         MAXSET = 0
  457.         FIRST = .FALSE.
  458.         DO 10 I = 1, LIMIT
  459.           OUTTYP(I) = -100
  460.    10   CONTINUE
  461.       ENDIF
  462.       IF(MAXSET .EQ. LIMIT) RETURN
  463.       IF(TYPE .LE. 0) RETURN
  464.  
  465.       IF(FD1 .GT. 0) CALL SEEK(0, FD1)
  466.       IF(FD2 .GT. 0) CALL SEEK(0, FD2)
  467.  
  468.       MAXSET = MAXSET + 1
  469.       DO 20 I = 1, LIMIT
  470.         IF(OUTTYP(I) .EQ. -100) THEN
  471.           OUTTYP(I) = TYPE
  472.           FDTOKS(I) = FD1
  473.           FDCMTS(I) = FD2
  474.           TPOINT(I) = 1
  475.           CPOINT(I) = 1
  476.           LSTTKN(I) = 0
  477.  
  478.           ZTKPTI = I
  479.           RETURN
  480.         ENDIF
  481.    20 CONTINUE
  482.  
  483.       END
  484. C----------------------------------------------------
  485. C
  486. C  TERMINATE TOKEN OUTPUT.
  487. C
  488.       SUBROUTINE ZTKPTQ(CHAN)
  489.  
  490.       INTEGER  CHAN
  491.  
  492.       INTEGER LIMIT, MAXSET, LENT, SIZE
  493.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  494.  
  495.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  496.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  497.      +        LSTTKN(LIMIT), OUTTYP(LIMIT)
  498.       COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  499.      +        LSTTKN, OUTTYP, MAXSET
  500.  
  501.       SAVE
  502.  
  503.       OUTTYP(CHAN) = -100
  504.       MAXSET = MAX(MAXSET-1, 0)
  505.  
  506.       END
  507. C----------------------------------------------------
  508. C
  509. C  READ A TOKEN FROM A TOKEN STREAM/COMMENT FILE PAIR THAT
  510. C  HAVE BEEN INITIALISED USING ZTOKIN. THIS ROUTINE IS VERY
  511. C  SIMILAR TO ZTREAD BUT ALLOWS MULTIPLE PAIRS OF FILES
  512. C  TO BE IN USE AT THE SAME TIME.
  513. C
  514.       SUBROUTINE ZGETTK (TYPE, LENGTH, STRING, CNTRL, STATUS)
  515. C
  516. C---------------------------------------------------------
  517. C    TOOLPACK/1    Release: 2.1
  518. C---------------------------------------------------------
  519. C
  520. C  TKLAST = LAST TOKEN NUMBER
  521. C
  522.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  523.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  524.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  525.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  526.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  527.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  528.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  529.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  530.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  531.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  532.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  533.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  534.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  535.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  536.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  537.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  538.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  539.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  540.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  541.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  542.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  543.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  544.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  545.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  546.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  547.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  548.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  549.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  550.  
  551.       INTEGER TYPE, CNTRL, FIRST, SECOND, C, LENGTH,
  552.      +        I, STATUS
  553.       INTEGER STRING (*)
  554.  
  555.       INTEGER LIMIT, MAXSET, SIZE, LENT
  556.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  557.  
  558.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  559.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  560.      +        LSTTKN(LIMIT), INTYP(LIMIT)
  561.       COMMON /XCTKIN/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  562.      +        LSTTKN, INTYP, MAXSET
  563.       SAVE
  564. C
  565. C  CHECK THE LEGALITY OF THE REQUEST
  566. C
  567.       IF(CNTRL .LE. 0 .OR. CNTRL .GT. MAXSET) THEN
  568.         CALL REMARK('ZGETTK: CNTRL ARGUMENT OUT OF RANGE')
  569.         STATUS = -1
  570.         RETURN
  571.       ELSE IF(INTYP(CNTRL) .LE. 0) THEN
  572.         CALL REMARK('ZGETTK: CNTRL ARGUMENT NAMES AN INACTIVE STREAM')
  573.         STATUS = -1
  574.         RETURN
  575.       ENDIF
  576.  
  577.     5 CONTINUE
  578.       IF(LSTTKN(CNTRL) .EQ. TCMMNT) THEN
  579.         CALL XTKSUB(FIRST, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  580.      +              SIZE, FDCMTS(CNTRL), STATUS)
  581.         IF(STATUS .NE. -2) RETURN
  582.         CALL XTKSUB(SECOND, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  583.      +              SIZE, FDCMTS(CNTRL), STATUS)
  584.         IF(STATUS .NE. -2) RETURN
  585.  
  586.         LENGTH = (FIRST-48)*10 + SECOND - 48
  587.         DO 10 I = 1, LENGTH
  588.           CALL XTKSUB(C,  CPOINT(CNTRL), CMTBUF(1,CNTRL),
  589.      +              SIZE, FDCMTS(CNTRL), STATUS)
  590.           IF(STATUS .NE. -2) RETURN
  591.           STRING(I) = C
  592.    10   CONTINUE
  593.         STRING(I) = 129
  594.         TYPE = TCMMNT
  595.         IF(LENGTH .NE. 1) RETURN
  596.         IF(STRING(1) .NE. 36) RETURN
  597.  
  598.       ENDIF
  599.  
  600.       CALL XTKSUB(FIRST,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  601.      +              SIZE, FDTOKS(CNTRL), STATUS)
  602.       IF(STATUS .NE. -2) RETURN
  603.       CALL XTKSUB(SECOND,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  604.      +              SIZE, FDTOKS(CNTRL), STATUS)
  605.       IF(STATUS .NE. -2) RETURN
  606.  
  607.       TYPE = (FIRST-48)*10 + SECOND - 48
  608.       IF(TYPE .EQ. TCMMNT) THEN
  609.         LSTTKN(CNTRL) = TCMMNT
  610.         GO TO 5
  611.       ENDIF
  612.  
  613.       LENGTH = 0
  614.       DO 20 I = 1, 5
  615.         CALL XTKSUB(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  616.      +              SIZE, FDTOKS(CNTRL), STATUS)
  617.         IF(STATUS .NE. -2) RETURN
  618.         IF(FIRST .EQ. 32) GO TO 22
  619.         LENGTH = 10*LENGTH + FIRST-48
  620.    20 CONTINUE
  621.  
  622.    22 CONTINUE
  623.       DO 30 I = 1, LENGTH
  624.         CALL XTKSUB(C, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  625.      +              SIZE, FDTOKS(CNTRL), STATUS)
  626.         IF(STATUS .NE. -2) RETURN
  627.         STRING(I) = C
  628.    30 CONTINUE
  629.       STRING(I) = 129
  630.  
  631.       LSTTKN(CNTRL) = TYPE
  632.  
  633.       END
  634. C----------------------------------------------------------
  635. C
  636. C  DUMMY VERSION OF INPUT ROUTINE.
  637. C
  638.       SUBROUTINE ZSCAN(TKNTYP, TKNLEN, TKNSTR, DESC, STATUS)
  639.  
  640.       INTEGER TKNTYP, TKNLEN, TKNSTR(*), DESC, STATUS
  641.  
  642.       STATUS = -1
  643.  
  644.       END
  645. C----------------------------------------------------
  646. C
  647.       SUBROUTINE ZPUTTK(TYPE, LENGTH, STRING, CNTRL)
  648.  
  649.       INTEGER TYPE, LENGTH, CNTRL, I, FIRST, SECOND, THIRD,
  650.      +        FOURTH, ACTLEN
  651.       INTEGER STRING(*)
  652.  
  653. C---------------------------------------------------------
  654. C    TOOLPACK/1    Release: 2.1
  655. C---------------------------------------------------------
  656. C
  657. C  TKLAST = LAST TOKEN NUMBER
  658. C
  659.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  660.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  661.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  662.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  663.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  664.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  665.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  666.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  667.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  668.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  669.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  670.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  671.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  672.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  673.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  674.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  675.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  676.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  677.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  678.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  679.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  680.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  681.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  682.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  683.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  684.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  685.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  686.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  687.  
  688.  
  689.       INTEGER LIMIT, MAXSET, SIZE, LENT
  690.       PARAMETER (LIMIT = 2, SIZE = 132, LENT = SIZE + 2)
  691.  
  692.       INTEGER FDTOKS(LIMIT), FDCMTS(LIMIT), CMTBUF(LENT, LIMIT),
  693.      +        TKNBUF(LENT, LIMIT), TPOINT(LIMIT), CPOINT(LIMIT),
  694.      +        LSTTKN(LIMIT), OUTTYP(LIMIT)
  695.       COMMON /XCTKOT/ FDTOKS, FDCMTS, CMTBUF, TKNBUF, TPOINT, CPOINT,
  696.      +        LSTTKN, OUTTYP, MAXSET
  697.       SAVE
  698.  
  699.  
  700.       IF(CNTRL .LE. 0 .OR. CNTRL .GT. MAXSET) RETURN
  701.       IF(OUTTYP(CNTRL) .LE. 0) RETURN
  702.  
  703.       IF(TYPE .EQ. TCMMNT) THEN
  704.         IF(LSTTKN(CNTRL) .NE. TCMMNT) THEN
  705.           FIRST  = TYPE/10
  706.           SECOND = TYPE - (FIRST*10) + 48
  707.           FIRST  = FIRST + 48
  708.           CALL XTKADD(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  709.      +                SIZE, FDTOKS(CNTRL))
  710.           CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  711.      +                SIZE, FDTOKS(CNTRL))
  712.         ENDIF
  713.         ACTLEN = LENGTH
  714.     5   IF(STRING(ACTLEN) .EQ. 32) THEN
  715.           ACTLEN = ACTLEN - 1
  716.           IF(ACTLEN .GT. 0) GO TO 5
  717.         ENDIF
  718.         IF(ACTLEN .EQ. 0) THEN
  719.           CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  720.      +                SIZE, FDCMTS(CNTRL))
  721.           CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  722.      +                SIZE, FDCMTS(CNTRL))
  723.         ELSE
  724.           FIRST  = ACTLEN/10
  725.           SECOND = ACTLEN - (FIRST*10) + 48
  726.           FIRST  = FIRST + 48
  727.           CALL XTKADD(FIRST, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  728.      +                SIZE, FDCMTS(CNTRL))
  729.           CALL XTKADD(SECOND, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  730.      +                SIZE, FDCMTS(CNTRL))
  731.           DO 10 I = 1, ACTLEN
  732.             CALL XTKADD(STRING(I), CPOINT(CNTRL), CMTBUF(1,CNTRL),
  733.      +                SIZE, FDCMTS(CNTRL))
  734.    10     CONTINUE
  735.         ENDIF
  736.  
  737.       ELSE
  738.         IF(LSTTKN(CNTRL) .EQ. TCMMNT) THEN
  739.           CALL XTKADD(48, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  740.      +                SIZE, FDCMTS(CNTRL))
  741.           CALL XTKADD(49, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  742.      +                SIZE, FDCMTS(CNTRL))
  743.           CALL XTKADD(36, CPOINT(CNTRL), CMTBUF(1,CNTRL),
  744.      +                SIZE, FDCMTS(CNTRL))
  745.         ENDIF
  746.         FIRST  = TYPE/10
  747.         SECOND = TYPE - (FIRST*10) + 48
  748.         FIRST  = FIRST + 48
  749.         CALL XTKADD(FIRST, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  750.      +              SIZE, FDTOKS(CNTRL))
  751.         CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  752.      +              SIZE, FDTOKS(CNTRL))
  753.  
  754.         FIRST  =  LENGTH/1000
  755.         SECOND = (LENGTH - (FIRST*1000))/100
  756.         THIRD  = (LENGTH - (FIRST*1000) - (SECOND*100))/10
  757.         FOURTH =  LENGTH - (FIRST*1000) - (SECOND*100) - (THIRD*10)
  758.         FIRST  = FIRST + 48
  759.         SECOND = SECOND + 48
  760.         THIRD  = THIRD + 48
  761.         FOURTH = FOURTH + 48
  762.         IF(FIRST .NE. 48) THEN
  763.           CALL XTKADD(FIRST , TPOINT(CNTRL), TKNBUF(1,CNTRL),
  764.      +                SIZE, FDTOKS(CNTRL))
  765.           CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  766.      +                SIZE, FDTOKS(CNTRL))
  767.           CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  768.      +                SIZE, FDTOKS(CNTRL))
  769.           CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  770.      +                SIZE, FDTOKS(CNTRL))
  771.         ELSE IF(SECOND .NE. 48) THEN
  772.           CALL XTKADD(SECOND, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  773.      +                SIZE, FDTOKS(CNTRL))
  774.           CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  775.      +                SIZE, FDTOKS(CNTRL))
  776.           CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  777.      +                SIZE, FDTOKS(CNTRL))
  778.         ELSE IF(THIRD .NE. 48) THEN
  779.           CALL XTKADD(THIRD,  TPOINT(CNTRL), TKNBUF(1,CNTRL),
  780.      +                SIZE, FDTOKS(CNTRL))
  781.           CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  782.      +                SIZE, FDTOKS(CNTRL))
  783.         ELSE IF(FOURTH .NE. 48) THEN
  784.           CALL XTKADD(FOURTH, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  785.      +                SIZE, FDTOKS(CNTRL))
  786.         ENDIF
  787.         CALL XTKADD(32, TPOINT(CNTRL), TKNBUF(1,CNTRL),
  788.      +                SIZE, FDTOKS(CNTRL))
  789.         DO 20 I = 1, LENGTH
  790.           CALL XTKADD(STRING(I), TPOINT(CNTRL), TKNBUF(1,CNTRL),
  791.      +                SIZE, FDTOKS(CNTRL))
  792.    20   CONTINUE
  793.  
  794.         IF(TYPE .EQ. TZEOF) THEN
  795.           I = TPOINT(CNTRL)
  796.           CALL XTKADD(32,TPOINT(CNTRL),TKNBUF(1,CNTRL),I,FDTOKS(CNTRL))
  797.           I = CPOINT(CNTRL)
  798.           CALL XTKADD(32,CPOINT(CNTRL),CMTBUF(1,CNTRL),I,FDCMTS(CNTRL))
  799.         ENDIF
  800.  
  801.       ENDIF
  802.  
  803.       LSTTKN(CNTRL) = TYPE
  804.  
  805.       END
  806. C----------------------------------------------------------
  807. C
  808. C  DUMMY VERSION OF OUTPUT ROUTINE.
  809. C
  810.       SUBROUTINE ZUSCAN(TKNTYP, TKNLEN, TKNSTR, DESC)
  811.  
  812.       INTEGER TKNTYP, TKNLEN, TKNSTR(*), DESC
  813.  
  814.       END
  815. C----------------------------------------------------
  816. C
  817.       SUBROUTINE XTKADD(CHAR, POINT, BUFF, LIMIT, FD)
  818.  
  819.       INTEGER CHAR, POINT, LIMIT, FD, I
  820.       INTEGER BUFF(*)
  821.  
  822.       IF(FD .EQ. -1) RETURN
  823.       BUFF(POINT) = CHAR
  824.       POINT = POINT + 1
  825.       IF(POINT .GT. LIMIT) THEN
  826.         POINT = 1
  827.         DO 10 I = 1, LIMIT
  828.           CALL PUTCH(BUFF(I), FD)
  829.    10   CONTINUE
  830.         CALL PUTCH(10, FD)
  831.       ENDIF
  832.  
  833.       END
  834. C----------------------------------------------------
  835. C
  836.       SUBROUTINE XTKSUB(CHAR, POINT, BUFF, LIMIT, FD, STATUS)
  837.  
  838.       INTEGER CHAR, POINT, LIMIT, FD, I, STATUS
  839.       INTEGER BUFF(*)
  840.       INTEGER ZGTCMD
  841.  
  842.       IF(POINT .GT. LIMIT) THEN
  843.         POINT = 1
  844.         STATUS = ZGTCMD(BUFF, FD)
  845.         IF(STATUS .EQ. -1) RETURN
  846.         IF(STATUS .EQ. -100) RETURN
  847.         DO 10 I = STATUS + 1, LIMIT
  848.           BUFF(I) = 32
  849.    10   CONTINUE
  850.       ENDIF
  851.  
  852.       STATUS = -2
  853.       CHAR = BUFF(POINT)
  854.       POINT = POINT + 1
  855.  
  856.       END
  857.